home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROGS.ZIP / MEMSUM.ICN < prev    next >
Text File  |  1992-09-28  |  7KB  |  239 lines
  1. ############################################################################
  2. #
  3. #    File:     memsum.icn
  4. #
  5. #    Subject:  Program to summarize Icon memory management
  6. #
  7. #    Author:   Ralph E. Griswold
  8. #
  9. #    Date:     April 17, 1990
  10. #
  11. ###########################################################################
  12. #
  13. #     This program is a filter for Icon allocation history files (see IPD113).
  14. #  It tabulates the number of allocations by type and the total amount of
  15. #  storage (in bytes) by type.
  16. #
  17. #     It takes an Icon allocation history file from standard input and writes to
  18. #  standard output.
  19. #
  20. #     The command-line options are:
  21. #
  22. #    -t    produce tab-separated output for use in spreadsheets (the
  23. #           default is a formatted report)
  24. #
  25. #    -d    produce debugging output
  26. #
  27. #    -g    produce garbage-collection details (formatted report only)
  28. #
  29. #    -z    list types with zero allocation (the default is to not list
  30. #           them)
  31. #
  32. #  Some assumptions are made about where newlines occur -- specifically
  33. #  that verification commands are on single lines and that refresh and
  34. #  garbage collection data are on multiple lines.
  35. #
  36. ############################################################################
  37. #
  38. #  Links: numbers, options
  39. #
  40. ############################################################################
  41.  
  42. link numbers, options
  43.  
  44. global cmds, highlights, lastlen, alloccnt, alloctot, collections
  45. global mmunits, diagnose, namemap, zeroes, gdetail
  46.  
  47. procedure main(args)
  48.    local line, region, s, skip, opts, prefix
  49.  
  50.    opts := options(args,"dgtz")
  51.    diagnose := if \opts["d"] then write else 1
  52.    gdetail := if \opts["g"] then 1
  53.    display := if \opts["t"] then spread else report
  54.    zeroes := if \opts["z"] then 1
  55.  
  56.    cmds := 'cefihLlRrSsTtux"XAF'    # command characters
  57.    highlights := '%$Y'            # highlight commands
  58.    mmunits := 4                # default; reset if different
  59.    namemap := table("*** undefined ***")
  60.    namemap["b"] := "large integer"
  61.    namemap["c"] := "cset"
  62.    namemap["e"] := "table-element tv"
  63.    namemap["f"] := "file"
  64.    namemap["h"] := "hash block"
  65.    namemap["i"] := "large integer"
  66.    namemap["L"] := "list header"
  67.    namemap["l"] := "list element"
  68.    namemap["R"] := "record"
  69.    namemap["r"] := "real number"
  70.    namemap["S"] := "set header"
  71.    namemap["s"] := "set element"
  72.    namemap["T"] := "table header"
  73.    namemap["t"] := "table element"
  74.    namemap["u"] := "substring tv"
  75.    namemap["x"] := "refresh block"
  76.    namemap["\""] := "string"
  77.    namemap["X"] := "co-expression"
  78.    namemap["A"] := "alien block"
  79.    namemap["F"] := "free space"
  80.  
  81.    lastlen := table()            # last size
  82.    alloccnt := table(0)            # count of allocations
  83.    alloctot := table(0)            # total allocation
  84.    collections := list(4,0)        # garbage collection counts
  85.  
  86.    every alloccnt[!cmds] := 0
  87.    every alloctot[!cmds] := 0
  88.  
  89.    cmds ++:= highlights
  90.  
  91.    while line := read() do        # input from allocation history file
  92.       line ? {
  93.          if prefix := tab(upto('{=#;!<>')) then {
  94.             case move(1) of {
  95.                !"=#;!>": next
  96.                "{": {            # refresh sequence
  97.                   collections[prefix] +:= 1
  98.                   while line := read() | stop("**** premature eof") do
  99.                      line ? if upto('#!') then break next
  100.                   }
  101.                "<": {
  102.                   mmunits := integer(prefix)    # covers old case with no value
  103.                   while line := read() | stop("**** premature eof") do
  104.                      line ? if upto('#>') then break next
  105.                   }
  106.                }
  107.             }
  108.             else {            # process allocation
  109.                while move(process(tab(upto(cmds) + 1)))
  110.                }
  111.             }
  112.  
  113.    display()
  114.  
  115. end
  116.  
  117. #  Display a table of allocation data
  118. #
  119. procedure report()
  120.    local name, cnt, cnttotal, i, tot, totalcoll, tottotal
  121.  
  122.    static col1, col2, gutter        # column widths
  123.  
  124.    initial {
  125.       col1 := 16            # name field
  126.       col2 := 10            # number field
  127.       gutter := repl(" ",6)
  128.       }
  129.  
  130.    write(,                # write column headings
  131.       "\n",
  132.       left("type",col1),
  133.       right("number",col2),
  134.       gutter,
  135.       right("bytes",col2),
  136.       gutter,
  137.       right("average",col2),
  138.       gutter,
  139.       right("% bytes",col2),
  140.       "\n"
  141.       )
  142.  
  143.    alloccnt := sort(alloccnt,3)                # get the data
  144.    alloctot := sort(alloctot,3)
  145.  
  146.    cnttotal := 0
  147.    tottotal := 0
  148.  
  149.    every i := 2 to *alloccnt by 2 do {
  150.       cnttotal +:= alloccnt[i]
  151.       tottotal +:= alloctot[i]
  152.       }
  153.  
  154.    while name := get(alloccnt) do {
  155.       if ((cnt := get(alloccnt)) = 0) & /zeroes then {    # skip zero entries
  156.          get(alloctot)                    # remove unused values
  157.          get(alloctot)
  158.          next                        # get next group
  159.          }
  160.       write(                        # write the data
  161.          left(namemap[name],col1),            # name
  162.          right(cnt,col2),                # number of allocations
  163.          gutter,
  164.          get(alloctot) & right(tot := get(alloctot),col2), # space allocated
  165.          gutter,
  166.          fix(tot,cnt,col2) | repl(" ",col2),
  167.          gutter,
  168.          fix(100.0 * tot,tottotal,col2) | repl(" ",col2)
  169.          )
  170.       }
  171.  
  172.    write(                        # write totals
  173.       "\n",
  174.       left("total:",col1),
  175.       right(cnttotal,col2),
  176.       gutter,
  177.       right(tottotal,col2),
  178.       gutter,
  179.       fix(tottotal,cnttotal,col2) | repl(" ",col2)
  180.       )
  181.  
  182.    totalcoll := 0                    # garbage collections
  183.    every totalcoll +:= !collections
  184.    write("\n",left("collections:",col1),right(totalcoll,col2))
  185.    if totalcoll > 0 then {
  186.       write(left("  static region:",col1),right(collections[1],col2))
  187.       write(left("  string region:",col1),right(collections[2],col2))
  188.       write(left("  block region:",col1),right(collections[3],col2))
  189.       write(left("  no region:",col1),right(collections[4],col2))
  190.       }
  191.  
  192.    return
  193. end
  194.  
  195. #  Produce tab-separated output for a spreadsheet.  The first column
  196. #  is the type name, the second column is the number of allocations,
  197. #  and the third column is the total number of bytes allocated for that
  198. #  type.
  199. #
  200. procedure spread()
  201.    local name, number, total
  202.  
  203.    alloccnt := sort(alloccnt,3)                # get the data
  204.    alloctot := sort(alloctot,3)
  205.  
  206.    write("type\tnumber\ttotal bytes")            # label row
  207.    while name := namemap[get(alloccnt)] do {
  208.       number := get(alloccnt)
  209.       get(alloctot)
  210.       total := get(alloctot)
  211.       if (number = 0) & /zeroes then next
  212.       write(name,"\t",number,"\t",total)
  213.       }
  214.  
  215.    return
  216. end
  217.  
  218. #  Process data
  219. #
  220. procedure process(s)
  221.    local cmd, len
  222.  
  223.    s ? {
  224.       tab(upto('+') + 1)        # skip address
  225.       len := tab(many(&digits)) | &null
  226.       cmd := move(1)
  227.  
  228.       if cmd == !highlights then return 2 else {
  229.                        # if given len is nonstring, scale
  230.          if cmd ~== "\"" then \len *:= mmunits
  231.          alloccnt[cmd] +:= 1
  232.          (/len := lastlen[cmd]) | (lastlen[cmd] := len)
  233.          diagnose(&errout,"cmd=",cmd,", len=",len)
  234.          alloctot[cmd] +:= len
  235.          return 0
  236.          }
  237.       }
  238. end
  239.